home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / INT.68K < prev    next >
Text File  |  2001-09-30  |  34KB  |  1,232 lines
  1. ;INT.68K    MAR-20-87
  2. ;XPL intrinsics for the 68000
  3. ;Written by Loren Blaney
  4. ;This is derived from 6502 code written by P.J.R. Boyle.
  5. ;
  6. ;REVISION HISTORY:
  7. ;DEC-84, Original, known as: INT.68K.
  8. ;DEC-85, Added floating point intrinsics.
  9. ;FEB-86, Modified for 32-bit operations for DFM engineering.
  10. ;MAR-86, Modified for double-precision floating point.
  11. ;SEP-86, Converted to ASM68K conventions and modified.
  12. ;OCT-86, Modified to run in supervisor mode and to interface cleanly
  13. ;    with assembly language.
  14. ;NOV-86, Modified for second terminal (device 1)
  15. ;DEC-86, Added OPENF intrinsic and removed FASAVE
  16. ;FEB-87, Fixed test for file too long.
  17. ;MAR-87, Fixed remainder.
  18. ;
  19. ;Notes:
  20. ;These intrinsics may destroy the contents of registers D0 and A6;
  21. ; however, subroutines should not destroy the contents of registers. If,
  22. ; in the interest of speed, registers are not saved and restored, this
  23. ; should be clearly stated as part of the operation of the subroutine.
  24. ;
  25.     NOLIST
  26.     INCLUDE    SYSPAG        ;Get system page definitions
  27.     LIST
  28.  
  29. ;-----------------------------------------------------------------------
  30. ;INTRINSIC JUMP TABLE
  31. ;
  32.     ORG    INTTBL        ;Compiler expects the jump table here
  33.  
  34.     JMP    ABS.L        ;0
  35.     JMP    RAN.L        ;1
  36.     JMP    REM.L        ;2
  37.     JMP    RESERV.L    ;3
  38.     JMP    SWAP.L        ;4
  39.     JMP    EXTEND.L    ;5
  40.     JMP    RESTAR.L    ;6
  41.     JMP    CHIN.L        ;7
  42.     JMP    CHOUT.L        ;8
  43.     JMP    CRLF.L        ;9
  44.     JMP    INTIN.L        ;10
  45.     JMP    INTOUT.L    ;11
  46.     JMP    TEXT.L        ;12
  47.     JMP    OPENI.L        ;13
  48.     JMP    OPENO.L        ;14
  49.     JMP    CLOSE.L        ;15
  50.     JMP    ABORT.L        ;16
  51.     JMP    BADINT.L    ;TRAP.L        ;17
  52.     JMP    FREE.L        ;18
  53.     JMP    RERUN.L        ;19
  54.     JMP    GETHP.L        ;20
  55.     JMP    SETHP.L        ;21
  56.     JMP    BADINT.L    ;GETERR.L    ;22
  57.     JMP    CURSOR.L    ;23
  58.     JMP    SCAN.L        ;24
  59.     JMP    SETRUN.L    ;25
  60.     JMP    HEXIN.L        ;26
  61.     JMP    HEXOUT.L    ;27
  62.     JMP    CHAIN.L        ;28
  63.     JMP    OPENF.L        ;29
  64.     JMP    WRITE.L        ;30
  65.     JMP    READ.L        ;31
  66.     JMP    BADINT.L    ;TESTPT.L    ;32
  67.  
  68. ;Special intrinsics for Apex:
  69.     JMP    FGET.L        ;33
  70.     JMP    BADINT.L    ;FASAVE.L    ;34
  71.     JMP    FSAVE.L        ;35
  72.     JMP    BLIT.L        ;36
  73.  
  74. ;    JMP    BADINT.L    ;SETTXT.L    ;33
  75. ;    JMP    BADINT.L    ;SETHI.L    ;34
  76. ;    JMP    BADINT.L    ;SETMIX.L    ;35
  77. ;    JMP    BADINT.L    ;SETLO.L    ;36
  78.  
  79.     JMP    BADINT.L    ;BUTTON.L    ;37
  80.     JMP    BADINT.L    ;PADDLE.L    ;38
  81.     JMP    BADINT.L    ;SOUND.L    ;39
  82.     JMP    BADINT.L    ;CLEAR.L    ;40
  83.     JMP    BADINT.L    ;POINT.L    ;41
  84.     JMP    BADINT.L    ;LINE.L        ;42
  85.     JMP    BADINT.L    ;MOVE.L        ;43
  86.     JMP    BADINT.L    ;SCREEN.L    ;44
  87.     JMP    BADINT.L    ;BLOCK.L    ;45
  88.     JMP    RLRES.L        ;46
  89.     JMP    RLIN.L        ;47
  90.     JMP    RLOUT.L        ;48
  91.     JMP    FLOAT.L        ;49
  92.     JMP    FIX.L        ;50
  93.     JMP    RLABS.L        ;51
  94.     JMP    FORMAT.L    ;52
  95.     JMP    SQRT.L        ;53
  96.     JMP    LN.L        ;54
  97.     JMP    EXP.L        ;55
  98.     JMP    SIN.L        ;56
  99.     JMP    ATAN2.L        ;57
  100.     JMP    MOD.L        ;58
  101.     JMP    LOG.L        ;59
  102.     JMP    COS.L        ;60
  103.     JMP    TAN.L        ;61
  104.     JMP    ASIN.L        ;62
  105.     JMP    ACOS.L        ;63
  106.     JMP    BACKUP.L    ;64
  107.     JMP    BADINT.L    ;HICHAR.L    ;65
  108.     JMP    BADINT.L    ;PEEK.L        ;66
  109.     JMP    BADINT.L    ;POKE.L        ;67
  110.     JMP    BADINT.L    ;68
  111.     JMP    BADINT.L    ;69
  112.     JMP    BADINT.L    ;70
  113.     JMP    BADINT.L    ;71
  114.     JMP    BADINT.L    ;72
  115.     JMP    BADINT.L    ;73
  116.     JMP    BADINT.L    ;74
  117.     JMP    BADINT.L    ;75
  118.     JMP    BADINT.L    ;76
  119.     JMP    BADINT.L    ;77
  120.     JMP    BADINT.L    ;78
  121.     JMP    BADINT.L    ;79
  122.     JMP    BADINT.L    ;80
  123.     JMP    BADINT.L    ;81
  124.     JMP    BADINT.L    ;82
  125.     JMP    BADINT.L    ;83
  126.     JMP    BADINT.L    ;84
  127.     JMP    BADINT.L    ;85
  128.     JMP    BADINT.L    ;86
  129.     JMP    BADINT.L    ;87
  130.     JMP    BADINT.L    ;88
  131.     JMP    BADINT.L    ;89
  132.     JMP    BADINT.L    ;90
  133.     JMP    BADINT.L    ;91
  134.     JMP    BADINT.L    ;92
  135.     JMP    BADINT.L    ;93
  136.     JMP    BADINT.L    ;94
  137.     JMP    BADINT.L    ;95
  138.     JMP    BADINT.L    ;96
  139.     JMP    BADINT.L    ;97
  140.     JMP    BADINT.L    ;98
  141.     JMP    BADINT.L    ;99
  142.     JMP    BADINT.L    ;100
  143.     JMP    BADINT.L    ;101
  144.     JMP    BADINT.L    ;102
  145.     JMP    BADINT.L    ;103
  146.     JMP    BADINT.L    ;104
  147.     JMP    BADINT.L    ;105
  148.     JMP    BADINT.L    ;106
  149.     JMP    BADINT.L    ;107
  150.     JMP    BADINT.L    ;108
  151.     JMP    BADINT.L    ;109
  152.     JMP    BADINT.L    ;110
  153.     JMP    BADINT.L    ;111
  154.     JMP    BADINT.L    ;112
  155.     JMP    BADINT.L    ;113
  156.     JMP    BADINT.L    ;114
  157.     JMP    BADINT.L    ;115
  158.     JMP    BADINT.L    ;116
  159.     JMP    BADINT.L    ;117
  160.     JMP    BADINT.L    ;118
  161.     JMP    CURSOR1.L    ;119
  162.     JMP    BUTES1.L    ;120
  163.     JMP    SHOCUR1.L    ;121
  164.     JMP    DEVINFO.L    ;122
  165.     JMP    UNTINFO.L    ;123
  166.     JMP    BUTES.L        ;124
  167.     JMP    GETKEY.L    ;125
  168.     JMP    KEYHIT.L    ;126
  169.     JMP    SHOCUR.L    ;127
  170.  
  171. ;-----------------------------------------------------------------------
  172. ;All INT.68K variables are stored here. The compiler must know the
  173. ; location of REMAIN. The rest are grouped here for convenience when
  174. ; they are saved and restored by the multitasking exec.
  175. ;
  176. REMAIN    DS.L    1        ;Remainder of most recent divide
  177.  
  178. RANK    DC.L    2537        ;Random number seeds (initialized at
  179. RANL    DC.L    5149        ; load time)
  180. RANM    DC.L    7026        ;Random number that is actually output
  181.  
  182. BACKFL    DS.B    1        ;Backup flag, used to re-read last char
  183. LASTCH    DS.B    1        ;The last character read by BYTEIN
  184.  
  185. ;-----------------------------------------------------------------------
  186. ;
  187.     ORG    MEMTOP -$3800
  188. ;
  189. ;Illegal intrinsic handler. (Note: this would be improved a tremendous
  190. ; amount if it said where it came from.)
  191. ;
  192. BADINT    JSR    VERROR
  193.     ASCII    '105 - ILLEGAL INTRINSI'
  194.     DC.B    'C'+$80
  195.     RTS
  196.  
  197. ;-----------------------------------------------------------------------
  198. ;0
  199. ;Return the absolute value of the argument in D0.
  200. ; I:= ABS(J)
  201. ;
  202. ABS    MOVE.L    (A5),D0
  203.     BPL.S    ABS10
  204.     NEG.L    D0
  205. ABS10    RTS
  206.  
  207. ;-----------------------------------------------------------------------
  208. ;1
  209. ;Return a random number, between 0 and the argument-1, in D0.
  210. ; If the argument = 0, then the seeds are reinitialized (for a
  211. ; repeatable sequence). If the argument < 0 then randomize and
  212. ; return a positive value between 0 and -(argument-1).
  213. ; I:= RAN(10)
  214. ; *** THIS IS CURRENTLY A 16-BIT OPERATION ***
  215. ;
  216. RAN    TST.L    (A5)        ;Is the argument = 0
  217.     BNE.S    RANF10        ;Branch if not
  218.     BSR.S    RANINI        ;Initialize seeds
  219.     MOVEQ    #0,D0        ;Return 0
  220.     BRA.S    RANF90
  221.  
  222. RANF10    BPL.S    RANF20        ;Branch if the argument is positive
  223.     MOVE.L    HASH,RANM    ;Randomize with keyboard spinner
  224.     NEG.L    (A5)        ;Return a positive random number
  225.  
  226. RANF20    BSR.S    RANDOM        ;Get a random number
  227.     DIVS    2(A5),D0    ;D0:= REM(D0 / 2(A5))
  228.     CLR.W    D0        ;Clear quotient
  229.     SWAP    D0        ;Get remainder into low word
  230. RANF90    RTS
  231.  
  232. ;
  233. ;Initialize the random number seeds
  234. ;
  235. RANINI    MOVE.L    #2537,RANK    ;Reinitialize the seeds
  236.     MOVE.L    #5149,RANL
  237.     MOVE.L    #7026,RANM
  238.     RTS
  239.  
  240. ;
  241. ;Return a random number, between 0 and 10860, in D0.
  242. ;*** should be increased to 32 bit values ***    ????
  243. ;
  244. MODK    EQU    10909        ;Modulo values (prime numbers)
  245. MODL    EQU    10891
  246. MODM    EQU    10861
  247.  
  248. RANDOM    MOVE.L    RANK,D0        ;RANK:=2*RANK modulo MODK
  249.     ADD.L    D0,D0
  250.     CMP.L    #MODK,D0
  251.     BLT.S    RAN10
  252.     SUB.L    #MODK,D0
  253. RAN10    MOVE.L    D0,RANK
  254.  
  255.     MOVE.L    RANL,D0        ;RANL:=2*RANL modulo MODL
  256.     ADD.L    D0,D0
  257.     CMP.L    #MODL,D0
  258.     BLT.S    RAN20
  259.     SUB.L    #MODL,D0
  260. RAN20    MOVE.L    D0,RANL
  261.  
  262.     ADD.L    RANK,D0        ;RANM:= (RANK+RANL+RANM) modulo MODM
  263.     ADD.L    RANM,D0
  264. RAN30    CMP.L    #MODM,D0
  265.     BLT.S    RAN99
  266.     SUB.L    #MODM,D0
  267.     BRA.S    RAN30
  268.  
  269. RAN99    MOVE.L    D0,RANM
  270.     RTS
  271.  
  272. ;-----------------------------------------------------------------------
  273. ;2
  274. ;Return the remainder of the last integer divide in D0.
  275. ; The sign of the remainder is always the same as the dividend unless the
  276. ; remainder is equal to zero.
  277. ; I:= REM(5/3)
  278. ;
  279. REM    MOVE.W    REMAIN,D0    ;Get high word (the actual 16-bit
  280.     EXT.L    D0        ; remainder). Extend to 32-bits
  281.     RTS
  282.  
  283. ;-----------------------------------------------------------------------
  284. ;3
  285. ;Reserve heap space for an array (A5:= A5 + <ARG>).
  286. ; ADDR:= RESERVE(BYTES)
  287. ; The starting (low) address of the reserved space in returned in D0.
  288. ;WARNING: This assumes that the heap and the stack are arranged so that
  289. ; they grow toward each other.
  290. ;
  291. RESERV    MOVE.L    A5,D0        ;Return the base address in D0
  292.     BTST    #0,3(A5)    ;Make sure he is reserving an even
  293.     BEQ.S    RES10        ; number of bytes, branch if so
  294.     ADDQ.B    #1,3(A5)    ;Add one more byte to make it even
  295. RES10
  296.     ADDA.L    (A5),A5        ;Add the argument number of bytes
  297.                 ; to the heap pointer (A5)
  298.     CMPA.L    SP,A5        ;Check for memory overflow
  299.     BLO.S    RES90
  300.     JSR    VERROR
  301.     ASCII    '102 - MEMORY OVERFLO'
  302.     DC.B    'W'+$80
  303. RES90    RTS
  304.  
  305. ;-----------------------------------------------------------------------
  306. ;4
  307. ;Swap bytes in a word.
  308. ; The swapped bytes of the argument are returned in D0.
  309. ; I:= SWAP($3412)
  310. ;
  311. SWAP    MOVE.L    (A5),D0
  312.     ROL.W    #8,D0
  313.     RTS
  314.  
  315. ;-----------------------------------------------------------------------
  316. ;5
  317. ;Extend the sign bit of a byte to 32 bits (a word).
  318. ; The sign-extended argument is returned in D0.
  319. ; I:= EXTEND($80)
  320. ;
  321. EXTEND    MOVE.B    3(A5),D0
  322.     EXT.W    D0
  323.     EXT.L    D0
  324.     RTS
  325.  
  326. ;-----------------------------------------------------------------------
  327. ;6
  328. ;Restart the current (XPL) program.
  329. ; RESTART
  330. ;
  331. RESTAR    ST    RERUNF        ;Set the RERUN flag
  332.     CLR.L    ERRLOC        ;Indicate no errors
  333.     MOVEA.L    STACK,SP    ;Set the stack pointer
  334.     MOVEA.L    HEAP,A5        ;Set the heap pointer
  335.     JSR    VRSTRT        ;Call the current program
  336.     JSR    VSHOERR        ;Display any errors
  337.     JMP    VEXIT        ;Take the program's exit vector
  338.  
  339. ;-----------------------------------------------------------------------
  340. ;7
  341. ;Return a byte from input device DEV in D0.
  342. ; BYTE:= CHIN(DEV);
  343. ;
  344. CHIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  345.     BRA    BYTEIN        ;(PBRA) returns with byte in D0
  346.  
  347. ;-----------------------------------------------------------------------
  348. ;8
  349. ;Send a byte to device DEV.
  350. ; CHOUT(DEV,BYTE);
  351. ; A6 and D0 are destroyed.
  352. ;
  353. CHOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  354.     MOVE.B    7(A5),D0    ;Get the character
  355.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  356.     JMP    VDEVHAN        ;(PJMP) output D0
  357.  
  358. ;-----------------------------------------------------------------------
  359. ;9
  360. ;Send a "new line" command to DEV
  361. ; CRLF(DEV)
  362. ; A6 and D0 are destroyed.
  363. ;
  364. CRLF    MOVE.B    3(A5),DEVICE    ;Get the device number
  365.     MOVEQ    #CR,D0        ;CR = new line (LF is not used)
  366.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  367.     JMP    VDEVHAN        ;(PJMP) do I/O
  368.  
  369. ;-----------------------------------------------------------------------
  370. ;10
  371. ;Get a signed, decimal ASCII string from device DEV, convert it to a
  372. ; binary long word, and return it in D0.
  373. ; I:= INTIN(DEV)
  374. ;
  375. INTIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  376.     BRA    INTI        ;(PBRA) return the integer in D0
  377.  
  378. ;-----------------------------------------------------------------------
  379. ;11
  380. ;Convert a 32-bit integer to a signed, decimal ASCII string and send it
  381. ; out to device DEV.
  382. ; INTOUT(DEV,I)
  383. ; D0 is destroyed.
  384. ;
  385. INTOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  386.     MOVE.L    4(A5),D0    ;Get the integer
  387.     BRA    INTO        ;(PBRA) output the integer
  388.  
  389. ;-----------------------------------------------------------------------
  390. ;12
  391. ;Output the ASCII string at address ADDR to I/O device DEV.
  392. ; TEXT(DEV,ADDR)
  393. ; A6 is destroyed.
  394. ;
  395. TEXT    MOVE.B    3(A5),DEVICE    ;Get the device number
  396.     MOVEA.L    4(A5),A6    ;Get the address
  397.     BRA    TEXTO        ;(PBRA) output the string
  398.  
  399. ;-----------------------------------------------------------------------
  400. ;13
  401. ;Open (initialize) a device for input.
  402. ; OPENI(DEV)
  403. ; A6 is destroyed.
  404. ;
  405. OPENI    MOVE.B    3(A5),DEVICE    ;Get the device number
  406.     MOVEA.W    #0,A6        ;Set the function code = OPENI
  407.     JMP    VDEVHAN        ;(PJMP) do I/O
  408.  
  409. ;-----------------------------------------------------------------------
  410. ;14
  411. ;Open (initialize) a device for output.
  412. ; OPENO(DEV)
  413. ; A6 is destroyed.
  414. ;
  415. OPENO    MOVE.B    3(A5),DEVICE    ;Get the device number
  416.     MOVEA.W    #4,A6        ;Set the function code = OPENO
  417.     JMP    VDEVHAN        ;(PJMP) do I/O
  418.  
  419. ;-----------------------------------------------------------------------
  420. ;15
  421. ;Close an output device (flushes buffers, etc.)
  422. ; CLOSE(DEV)
  423. ; A6 is destroyed.
  424. ;
  425. CLOSE    MOVE.B    3(A5),DEVICE    ;Get the device number
  426.     MOVEA.W    #16,A6        ;Set the function code = CLOSE
  427.     JMP    VDEVHAN        ;(PJMP) do I/O
  428.  
  429. ;-----------------------------------------------------------------------
  430. ;16
  431. ;Abort the XPL program (same as a CTRL-P exit)
  432. ; ABORT
  433. ;
  434. ABORT    JMP    VABORT
  435.  
  436. ;-----------------------------------------------------------------------
  437. ;17
  438. TRAP    RTS
  439.  
  440. ;-----------------------------------------------------------------------
  441. ;18
  442. ;Return the amount of free space left in the heap and the stack.
  443. ; WARNING: It is assumed here that the stack and the heap are set up
  444. ; such that they grow toward each other.
  445. ; I := FREE
  446. ;
  447. FREE    MOVE.L    SP,D0        ;RETURN (SP - A5)
  448.     SUB.L    A5,D0
  449.     RTS
  450.  
  451. ;-----------------------------------------------------------------------
  452. ;19
  453. ;Return the rerun flag
  454. ; FLAG := RERUN
  455. ;
  456. RERUN    MOVE.B    RERUNF,D0
  457.     EXT.W    D0
  458.     EXT.L    D0
  459.     RTS
  460.  
  461. ;-----------------------------------------------------------------------
  462. ;20
  463. ;Return the heap pointer
  464. ; ADDR := GETHP
  465. ;
  466. GETHP    MOVE.L    A5,D0
  467.     RTS
  468.  
  469. ;-----------------------------------------------------------------------
  470. ;21
  471. ;Set the heap pointer.
  472. ; SETHP($2000)
  473. ; (The user had better have a good idea of the functioning of XPL before
  474. ; dinging with the heap pointer or he will surely bomb himself!)
  475. ; A6 is destroyed.
  476. ;
  477. SETHP    MOVEA.L    (A5),A5
  478.     RTS
  479.  
  480. ;-----------------------------------------------------------------------
  481. ;22
  482. ; I:= GETERR;
  483. GETERR
  484.     RTS
  485.  
  486. ;-----------------------------------------------------------------------
  487. ;23
  488. ;Move cursor of device 0 to column X, line Y. Upper left corner is
  489. ;  X,Y = 0,0.
  490. ; CURSOR(X,Y)
  491. ; A6 is destroyed.
  492. ;
  493. CURSOR    MOVE.B    #0,DEVICE    ;Set to device number 0
  494.  
  495.     MOVE.B    3(A5),D0    ;Get X position
  496.     ROL.W    #8,D0        ;Put it into high byte of D0
  497.     MOVE.B    7(A5),D0    ;Get Y position into low byte
  498.  
  499.     MOVEA.W    #28,A6        ;Set function code = "position cursor"
  500.     JMP    VDEVHAN        ;(PJMP) do I/O
  501.  
  502. ;-----------------------------------------------------------------------
  503. ;24
  504. ;Scan the directory for a file name and return its start and end blocks
  505. ; SCAN(UNIT, INFO, NAME)
  506. ;    UNIT - unit number (0-7)
  507. ;    INFO - the address of a 2-integer array where the starting and
  508. ;        ending blocks are returned
  509. ;    NAME - the address of a 12-byte file name
  510. ;        (note: the 11th byte cannot have its MSB set)
  511. ;
  512. SCAN    MOVE.B    3(A5),UNIT    ;Get the unit argument
  513.     MOVEA.L    8(A5),A6    ;Point A6 to the file name
  514.     JSR    VFSCAN        ;Scan for the name (heap is not used)
  515.  
  516.     MOVEA.L    4(A5),A6    ;Get the address of the info array
  517.     MOVE.L    BLKNO,(A6)    ;Put the start and end blocks into it
  518.     MOVE.L    ENDBLK,4(A6)
  519.     RTS
  520.  
  521. ;-----------------------------------------------------------------------
  522. ;25
  523. ;Set the RERUN flag
  524. ; SETRUN('TRUE')
  525. ;
  526. SETRUN    MOVE.B    #FALSE,RERUNF    ;Assume it is false (=0)
  527.     TST.L    (A5)
  528.     BEQ.S    SR90
  529.     ST    RERUNF        ;Set it true if any bit was set
  530. SR90    RTS
  531.  
  532. ;-----------------------------------------------------------------------
  533. ;26
  534. ;Get a hex ASCII string from device DEV, convert it to a binary word,
  535. ; and return it in D0.
  536. ; I:= HEXIN(DEV)
  537. ;
  538. HEXIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  539.     BRA    HEXI        ;(PBRA) get the hex integer in D0
  540.  
  541. ;-----------------------------------------------------------------------
  542. ;27
  543. ;Convert a 32-bit integer to an unsigned, hex ASCII string and send it
  544. ; out to device DEV.
  545. ; HEXOUT(DEV,I)
  546. ;
  547. HEXOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  548.     MOVE.L    4(A5),D0    ;Get the integer
  549.     BRA    HEXO        ;(PBRA) output the hex integer
  550.  
  551. ;-----------------------------------------------------------------------
  552. ;28
  553. ;Run a .SAV file
  554. ; CHAIN(UNIT, BLKNO)
  555. ;
  556. CHAIN    MOVE.B    3(A5),UNIT    ;Get the arguments
  557.     MOVE.L    4(A5),BLKNO
  558.     JMP    VFRUN        ;Go run it (never returns)
  559.  
  560. ;-----------------------------------------------------------------------
  561. ;29
  562. ;Open a disk file for input
  563. ; OPENF(UNIT, INFO);
  564. ;    UNIT - unit number (0-7)
  565. ;    INFO - the address of a 2-integer array containing the starting
  566. ;        and ending blocks (usually gotten from SCAN)
  567. ;
  568. OPENF    MOVE.B    3(A5),INUNT    ;Set the input unit
  569.  
  570.     MOVEA.L    4(A5),A6    ;Get the address of the array
  571.     MOVE.L    (A6),INLBLK    ;Set the starting block number
  572.     MOVE.L    4(A6),INHBLK    ;Set the ending block number
  573.     MOVE.B    #1,INFLG    ;1 = SETUP
  574.  
  575.     MOVE.B    #3,DEVICE    ;Open the disk file for input
  576.     MOVEA.W    #0,A6        ;Set the function code = OPENI
  577.     JMP    VDEVHAN        ;(PJMP) do I/O
  578.  
  579. ;-----------------------------------------------------------------------
  580. ;30
  581. ;Write the memory at BUFFER to UNIT for SIZE many BLOCKS
  582. ; WRITE(UNIT, BLOCK, BUFFER, SIZE)
  583. ;
  584. WRITE    MOVE.B    3(A5),UNIT    ;Get the arguments
  585.     MOVE.L    4(A5),BLKNO
  586.     MOVE.L    8(A5),FADDR
  587.     MOVE.L    12(A5),NBLKS
  588.     MOVEA.W    #12,A6        ;Set "write" function code
  589.     JMP    VUNTHAN        ;(PJMP) perform the unit function code
  590.  
  591. ;-----------------------------------------------------------------------
  592. ;31
  593. ;Read into the memory at BUFFER FROM UNIT for SIZE many BLOCKS
  594. ; READ(UNIT, BLOCK, BUFFER, SIZE)
  595. ;
  596. READ    MOVE.B    3(A5),UNIT    ;Get the arguments
  597.     MOVE.L    4(A5),BLKNO
  598.     MOVE.L    8(A5),FADDR
  599.     MOVE.L    12(A5),NBLKS
  600.     MOVEA.W    #8,A6        ;Set "read" function code
  601.     JMP    VUNTHAN        ;(PJMP) perform the unit function code
  602.  
  603. ;-----------------------------------------------------------------------
  604. ;32
  605. ;MODE:=TESTPT(X, Y)
  606. TESTPT    RTS
  607.  
  608. ;======================================================================
  609. ;Special intrinsics for Apex
  610. ;-----------------------------------------------------------------------
  611. ;33
  612. ;Load a memory image and enter the monitor
  613. ; FGET(UNIT,BLKNO)
  614. ;
  615. FGET    MOVE.B    3(A5),UNIT    ;Get arguments
  616.     MOVE.L    4(A5),BLKNO
  617.     JMP    VFGET        ;(Never returns)
  618.  
  619. ;-----------------------------------------------------------------------
  620. ;34
  621. ;Write APEX.XPL to SYSTEM.SYS
  622. ; FASAVE(UNIT,BLKNO)
  623. ;
  624. ;FASAVE    MOVE.B    3(A5),UNIT    ;Get arguments
  625. ;    MOVE.L    4(A5),BLKNO
  626. ;    JMP    VFASAVE        ;(Never returns)
  627. ;
  628. ;-----------------------------------------------------------------------
  629. ;35
  630. ;Write a memory image for a .SAV file
  631. ; FSAVE(UNIT,BLKNO)
  632. ;
  633. FSAVE    MOVE.B    3(A5),UNIT    ;Get arguments
  634.     MOVE.L    4(A5),BLKNO
  635.     JMP    VFSAVE        ;(Never returns)
  636.  
  637. ;-----------------------------------------------------------------------
  638. ;36
  639. ;Routine to quickly move a block of memory.
  640. ; Move LEN many bytes from FROM to TO
  641. ; BLIT(TO, FROM, LEN)
  642. ;
  643. BLIT    MOVEM.L    D1/A0,-(SP)    ;Save register(s)
  644.                 ;Get arguments:
  645.     MOVEA.L    (A5),A6        ; TO
  646.     MOVEA.L    4(A5),A0    ; FROM
  647.     MOVE.L    8(A5),D0    ; LEN
  648.     MOVE.L    D0,D1        ;Put the high 16 bits of LEN into
  649.     SWAP    D1        ; a second counter, D1
  650.  
  651.     CMPA.L    A0,A6        ;If TO > FROM (i.e: moving forward in
  652.     BEQ.S    BLIT90        ; memory) then don't branch
  653.     BLO.S    BLIT20        ;Enter loop checking for LEN = 0
  654.  
  655.     ADDA.L    D0,A6        ;Move starting at the end of the block
  656.     ADDA.L    D0,A0        ;Add LEN to TO and FROM
  657.     BRA.S    BLIT40        ;Enter loop checking for LEN = 0
  658.  
  659. BLIT10    MOVE.B    (A0)+,(A6)+    ;Move block backward, pointers forward
  660. BLIT20    DBF    D0,BLIT10    ;Loop unitl D0 = -1
  661.     DBF    D1,BLIT10    ; and also D1 = -1
  662.     BRA.S    BLIT90        ;Exit
  663.  
  664. BLIT30    MOVE.B    -(A0),-(A6)    ;Move block forward, pointers backward
  665. BLIT40    DBF    D0,BLIT30    ;Loop unitl D0 = -1
  666.     DBF    D1,BLIT30    ; and also D1 = -1
  667.  
  668. BLIT90    MOVEM.L    (SP)+,D1/A0    ;Restore register(s)
  669.     RTS
  670.  
  671. ;;======================================================================
  672. ;;33
  673. ;SETTXT    RTS
  674. ;;
  675. ;;34
  676. ;SETHI    RTS
  677. ;;
  678. ;;35
  679. ;SETMIX    RTS
  680. ;;
  681. ;;36
  682. ;SETLO    RTS
  683.  
  684. ;-----------------------------------------------------------------------
  685. ;37
  686. ;BOOLEAN:=BUTTON(NUMBER)
  687. BUTTON    RTS
  688. ;
  689.  
  690. ;38
  691. ;VARIALBE:=PADDLE(NUMBER)
  692. PADDLE    RTS
  693.  
  694. ;39
  695. ;SOUND(VOLUME, CYCLES, PERIOD);
  696. SOUND    RTS
  697.  
  698. ;40
  699. CLEAR    RTS
  700.  
  701. ;41
  702. ;POINT(X, Y, MODE)
  703. POINT    RTS
  704.  
  705. ;42
  706. ;LINE(X, Y, MODE)
  707. LINE    RTS
  708.  
  709. ;43
  710. ;MOVE(X, Y)
  711. MOVE    RTS
  712.  
  713. ;44
  714. ;VARIABLE:=SCREEN(X, Y)
  715. SCREEN    RTS
  716.  
  717. ;45
  718. ;BLOCK(X, Y, COLOR)
  719. BLOCK    RTS
  720.  
  721. ;======================================================================
  722. ;FLOATING POINT ROUTINES:
  723. ;-----------------------------------------------------------------------
  724. ;46
  725. ;Reserve heap space for a real array
  726. ; A5:= A5 + ARG *RLSIZE
  727. ; ADDR:= RLRES(REALS)
  728. ; The starting (low) address of the reserved space in returned in FP0.
  729. ;WARNING: This assumes that the heap and the stack are arranged so that
  730. ; they grow toward each other. This also assumes 8 bytes in a real.
  731. ;
  732. RLRES    MOVE.L    A5,D0        ;Return the base address in FP0
  733.     DC.W    $F200, $4000    ;FMOVE.L D0,FP0   (FLOAT)
  734.     MOVE.L    (A5),D0        ;Get the number of reals to reserve
  735.     LSL.L    #3,D0        ;Times 8 to get the number of bytes
  736.     ADDA.L    D0,A5        ;Add the argument number of bytes
  737.                 ; to the heap pointer (A5)
  738.     CMPA.L    SP,A5        ;Check for memory overflow
  739.     BLO.S    RRES90
  740.     JSR    VERROR
  741.     ASCII    '103 - MEMORY OVERFLO'
  742.     DC.B    'W'+$80
  743. RRES90    RTS
  744.  
  745. ;-----------------------------------------------------------------------
  746. ;47
  747. ; X:= RLIN(DEV);
  748. ;
  749. RLIN    BRA    BADINT
  750.  
  751. ;-----------------------------------------------------------------------
  752. ;48
  753. ; RLOUT(DEV,X);
  754. ;
  755. RLOUT    BRA    BADINT
  756.  
  757. ;-----------------------------------------------------------------------
  758. ;49
  759. ;X:= FLOAT(I);
  760. ;(FMOVE.L -8(SP),FP0 is not implemented in FPP.68K)
  761. ;
  762. FLOAT    MOVE.L    (A5),D0
  763.     DC.W    $F200, $4000    ;FMOVE.L D0,FP0
  764.     RTS
  765.  
  766. ;-----------------------------------------------------------------------
  767. ;50
  768. ;I:= FIX(X);
  769. ;
  770. FIX    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  771.     DC.W    $F200, $6000    ;FMOVE.L FP0,D0
  772.     RTS
  773.  
  774. ;-----------------------------------------------------------------------
  775. ;51
  776. ;X:= RLABS(X);
  777. ;
  778. RLABS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  779.     DC.W    $F200, $0018    ;FABS.X FP0
  780.     RTS
  781.  
  782. ;-----------------------------------------------------------------------
  783. ;52
  784. ;FORMAT(M,N);
  785. ;
  786. FORMAT    BRA.L    BADINT
  787.  
  788. ;-----------------------------------------------------------------------
  789. ;53
  790. ;X:= SQRT(X);
  791. ;(FSQRT.D (A5),FP0 et cetra are not implemented in FPP.68K)
  792. ;
  793. SQRT    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  794.     DC.W    $F200, $0004    ;FSQRT.X FP0
  795.     RTS
  796.  
  797. ;-----------------------------------------------------------------------
  798. ;54
  799. ;X:= LN(X);
  800. ;
  801. LN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  802.     DC.W    $F200, $0014    ;FLOGN.X FP0
  803.     RTS
  804.  
  805. ;-----------------------------------------------------------------------
  806. ;55
  807. ;X:= EXP(X);
  808. ;
  809. EXP    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  810.     DC.W    $F200, $0010    ;FETOX.X FP0
  811.     RTS
  812.  
  813. ;-----------------------------------------------------------------------
  814. ;56
  815. ;X:= SIN(X);
  816. ;
  817. SIN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  818.     DC.W    $F200, $000E    ;FSIN.X FP0
  819.     RTS
  820.  
  821. ;-----------------------------------------------------------------------
  822. ;57
  823. ;X:= ATAN2(Y,X);
  824. ;
  825. ATAN2    BRA.L    BADINT
  826.  
  827. ;-----------------------------------------------------------------------
  828. ;58
  829. ;X:= MOD(A,B);
  830. ;
  831. MOD    BRA.L    BADINT
  832.  
  833. ;-----------------------------------------------------------------------
  834. ;59
  835. ;X:= LOG(X);
  836. ;
  837. LOG    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  838.     DC.W    $F200, $0015    ;FLOG10.X FP0
  839.     RTS
  840.  
  841. ;-----------------------------------------------------------------------
  842. ;60
  843. ;X:= COS(X);
  844. ;
  845. COS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  846.     DC.W    $F200, $001D    ;FCOS.X FP0
  847.     RTS
  848.  
  849. ;-----------------------------------------------------------------------
  850. ;61
  851. ;X:= TAN(X);
  852. ;
  853. TAN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  854.     DC.W    $F200, $000F    ;FTAN.X FP0
  855.     RTS
  856.  
  857. ;-----------------------------------------------------------------------
  858. ;62
  859. ;X:= ASIN(X);
  860. ;
  861. ASIN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  862.     DC.W    $F200, $000C    ;FACOS.X FP0
  863.     RTS
  864.  
  865. ;-----------------------------------------------------------------------
  866. ;63
  867. ;X:= ACOS(X);
  868. ;
  869. ACOS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  870.     DC.W    $F200, $001C    ;FACOS.X FP0
  871.     RTS
  872.  
  873. ;-----------------------------------------------------------------------
  874. ;64
  875. ;Set the backup flag, so the next CHIN will reread the same byte.
  876. ;BACKUP
  877. ;
  878. BACKUP    ST    BACKFL        ;Set on condition true, i.e. always
  879.     RTS
  880.  
  881. ;======================================================================
  882. ;-----------------------------------------------------------------------
  883. ;65
  884. ;HICHAR(X, Y, MODE, ROT, CHAR)
  885. ;
  886. HICHAR    RTS
  887.  
  888. ;-----------------------------------------------------------------------
  889. ;66
  890. ;Return the value of the byte in the Apple at the given address
  891. ;BYTE:=PEEK(ADDRESS)
  892. ;
  893. PEEK    RTS
  894.  
  895. ;-----------------------------------------------------------------------
  896. ;67
  897. ;Store the byte in the Apple at the given address
  898. ;POKE(ADDR,BYTE)
  899. ;
  900. POKE    RTS
  901.  
  902. ;======================================================================
  903. ;----------------------------------------------------------------------
  904. ;119
  905. ;Move cursor on the second terminal (device #1) to column X, line Y.
  906. ; Upper left corner is X,Y = 0,0.
  907. ; CURSOR1(X,Y)
  908. ; A6 is destroyed.
  909. ;
  910. CURSOR1    MOVE.B    #1,DEVICE    ;Set to device number 1
  911.  
  912.     MOVE.B    3(A5),D0    ;Get X position
  913.     ROL.W    #8,D0        ;Put it into high byte of D0
  914.     MOVE.B    7(A5),D0    ;Get Y position into low byte
  915.  
  916.     MOVEA.W    #28,A6        ;Set function code = "position cursor"
  917.     JMP    VDEVHAN        ;(PJMP) do I/O
  918.  
  919. ;-----------------------------------------------------------------------
  920. ;120
  921. ;Set the display attributes for the second terminal (device #1)
  922. ; BUTES1($1);
  923. ;The bits in the argument set the attributes as follows:
  924. ;    0 - bold (not dim)
  925. ;    1 - underline
  926. ;    2 - inverse video
  927. ;    3 - flashing
  928. ;
  929. ;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
  930. ; inserting a space character whenever attributes are changed.
  931. ;
  932. BUTES1    MOVE.L    (A5),D0        ;Get argument
  933.     MOVE.B    #1,DEVICE    ;Set to device # 1
  934.     MOVEA.W    #48,A6        ;Set function code for "butes"
  935.     JMP    VDEVHAN        ;(PJMP) go do it
  936.  
  937. ;-----------------------------------------------------------------------
  938. ;121
  939. ;Turn the cursor indicator on or off for the second terminal (device #1)
  940. ; SHOCUR1('TRUE');
  941. ;
  942. SHOCUR1    MOVE.L    (A5),D0        ;Get boolean argument
  943.     MOVE.B    #1,DEVICE    ;Set to device # 1
  944.     MOVEA.W    #44,A6        ;Set function code for cursor control
  945.     JMP    VDEVHAN        ;(PJMP) go do it
  946.  
  947. ;-----------------------------------------------------------------------
  948. ;122
  949. ;Return the address of the information array for a device
  950. ; ADDR:= DEVINFO(DEV)
  951. ;
  952. DEVINFO    MOVE.B    3(A5),DEVICE    ;Get the device number
  953.     MOVEA.W    #20,A6        ;Set function code for "getinfo"
  954.     JMP    VDEVHAN        ;(PJMP) go do it
  955.  
  956. ;-----------------------------------------------------------------------
  957. ;123
  958. ;Return the address of the information array for a unit
  959. ; ADDR:= UNTINFO(UNIT)
  960. ;
  961. UNTINFO    MOVE.B    3(A5),UNIT    ;Get the unit number
  962.     MOVEA.W    #20,A6        ;Set function code for "getinfo"
  963.     JMP    VUNTHAN        ;(PJMP) go do it
  964.  
  965. ;-----------------------------------------------------------------------
  966. ;124
  967. ;Set the display attributes for device 0
  968. ; BUTES($1);
  969. ;The bits in the argument set the attributes as follows:
  970. ;    0 - bold (not dim)
  971. ;    1 - underline
  972. ;    2 - inverse video
  973. ;    3 - flashing
  974. ;
  975. ;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
  976. ; inserting a space character whenever attributes are changed.
  977. ;
  978. BUTES    MOVE.L    (A5),D0        ;Get argument
  979.     MOVE.B    #0,DEVICE    ;Set to device # 0
  980.     MOVEA.W    #48,A6        ;Set function code for "butes"
  981.     JMP    VDEVHAN        ;(PJMP) go do it
  982.  
  983. ;-----------------------------------------------------------------------
  984. ;125
  985. ;Wait for and then return the value of a key struck on
  986. ; the keyboard
  987. ; I:= GETKEY;
  988. ;
  989. GETKEY    MOVE.B    #1,DEVICE    ;Set to device # 1
  990.     MOVEA.W    #36,A6        ;Set function code for "getkey"
  991.     JMP    VDEVHAN        ;(PJMP) return with value in D0
  992.  
  993. ;-----------------------------------------------------------------------
  994. ;126
  995. ;Determine if a key (on the keyboard) has been struck
  996. ; I:= KEYHIT;
  997. ;
  998. KEYHIT    MOVE.B    #1,DEVICE    ;Set to device # 1
  999.     MOVEA.W    #40,A6        ;Set function code
  1000.     JMP    VDEVHAN        ;(PJMP) return with boolean in D0
  1001.  
  1002. ;-----------------------------------------------------------------------
  1003. ;127
  1004. ;Turn the cursor indicator on or off for device 0
  1005. ; SHOCUR('TRUE');
  1006. ;
  1007. SHOCUR    MOVE.L    (A5),D0        ;Get boolean argument
  1008.     MOVE.B    #0,DEVICE    ;Set to device # 0
  1009.     MOVEA.W    #44,A6        ;Set function code for cursor control
  1010.     JMP    VDEVHAN        ;(PJMP) go do it
  1011.  
  1012. ;=======================================================================
  1013. ;SUBROUTINES:
  1014. ;-----------------------------------------------------------------------
  1015. ;Input ASCII digits and convert them to a signed, decimal, 32-bit value
  1016. ; which is returned in D0.
  1017. ;    D0 = I/O
  1018. ;    D1 = Working register (contains number to be converted)
  1019. ;    D2 = Flag: a numeric character has been entered
  1020. ;    D3 = 10 multiplier
  1021. ;    D4 = Flag: a minus sign was entered, i.e. the number is negative
  1022. ;
  1023. INTI    MOVEM.L    D1-D4,-(SP)    ;Save registers
  1024.  
  1025. II00    MOVEQ    #0,D1        ;NUM:=0;
  1026.     CLR.B    D2        ;NUMFLG:=false
  1027.     CLR.B    D4        ;SIGN:=false
  1028.     MOVEQ    #10,D3
  1029.  
  1030.     BSR    BYTEIN        ;Get byte
  1031.     CMPI.B    #'-',D0        ;if D0 = ^- then SIGN := true
  1032.     BNE.S    II30
  1033.     MOVEQ    #TRUE,D4
  1034. ;                ;loop begin
  1035. II20    BSR    BYTEIN        ;Get byte
  1036. II30    CMPI.B    #'0',D0        ;  if D0<^0 ! D0>^9 then quit
  1037.     BLO.S    II50
  1038.     CMPI.B    #'9',D0
  1039.     BHI.S    II50
  1040.     MOVEQ    #TRUE,D2    ;  NUMFLG:=true
  1041.  
  1042.     MOVE.L    D1,D3        ;  NUM:= NUM*10 + (D0-^0)
  1043.     LSL.L    #2,D1        ;    *4
  1044.     ADD.L    D3,D1        ;    +1
  1045.     LSL.L    #1,D1        ;    *2
  1046.     SUBI.B    #'0',D0
  1047.     ADD.L    D0,D1
  1048.     BRA.S    II20        ;  end
  1049.  
  1050. II50    TST.B    D2        ;if NUMFLG then quit
  1051.     BEQ.S    II00
  1052.     TST.B    D4        ;if SIGN then NUM:= -NUM
  1053.     BEQ.S    II60
  1054.     NEG.L    D1
  1055. II60    MOVE.L    D1,D0        ;return NUM
  1056.  
  1057.     MOVEM.L    (SP)+,D1-D4    ;Restore registers
  1058.     RTS
  1059.  
  1060. ;-----------------------------------------------------------------------
  1061. ;Convert the signed, 32-bit value in D0 to decimal ASCII and output the
  1062. ; characters to DEVICE.
  1063. ;    D0 = I/O and subtract counter
  1064. ;    D1 = Working register (contains number to be converted)
  1065. ;    D2 = Flag used to suppress leading zeros (suppress if false)
  1066. ;    D3 = Power-of-ten (loop) counter
  1067. ;    D4 = Power of ten
  1068. ;    A0 = Pointer to power-of-ten table
  1069. ;
  1070. INTO    MOVEM.L    D0-D4/A0/A6,-(SP)    ;Save registers
  1071.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  1072.  
  1073.     MOVE.L    D0,D1        ;Put number into the working register
  1074.     BPL.S    INTO10        ;Branch if it is positive
  1075.     NEG.L    D1        ;Otherwise make it positive
  1076.     MOVEQ    #'-',D0        ;Output the minus sign
  1077.     JSR    VDEVHAN        ;Output D0
  1078.  
  1079.                 ;Initialize:
  1080. INTO10    MOVEQ    #FALSE,D2    ; flag used to suppress leading zeros
  1081.     MOVEQ    #8,D3        ; loop counter (8 down through 0)
  1082.     LEA    TENTBL.L,A0    ; pointer to power-of-ten table
  1083.  
  1084. INTO20    MOVE.L    (A0)+,D4    ;Get a power of ten
  1085.     MOVEQ    #9,D0        ;Init loop counter (9-0)
  1086. INTO30    SUB.L    D4,D1        ;Repeatedly subtract a power of ten
  1087.     DBMI    D0,INTO30    ; until it goes negative
  1088.     ADD.L    D4,D1        ;Restore to positive value
  1089.  
  1090.     NEG.B    D0        ;This digit = 9 - D0
  1091.     ADD.B    #9,D0
  1092.     BNE.S    INTO40        ;Branch if digit is not zero
  1093.     TST.B    D2        ;Are we suppressing leading zeros?
  1094.     BEQ.S    INTO50        ;Branch if we are (i.e. flag = false)
  1095. INTO40    MOVEQ    #TRUE,D2    ;Turn leading zero suppression off
  1096.     ADD.B    #'0',D0        ;Convert digit to ASCII
  1097.     JSR    VDEVHAN        ;Output it
  1098. INTO50    DBF    D3,INTO20    ;Repeat for powers 1,000,000,000 down
  1099.                 ; thru 10;
  1100.     MOVE.B    D1,D0        ;Output the one's digit regardless of
  1101.     ADD.B    #'0',D0        ; the leading zero suppression flag
  1102.     JSR    VDEVHAN
  1103.  
  1104.     MOVEM.L    (SP)+,D0-D4/A0/A6    ;Restore registers
  1105.     RTS
  1106.  
  1107. ;Power-of-ten table:
  1108. TENTBL    DC.L    1000000000    ;1g
  1109.     DC.L    100000000
  1110.     DC.L    10000000
  1111.     DC.L    1000000        ;1m
  1112.     DC.L    100000
  1113.     DC.L    10000
  1114.     DC.L    1000        ;1k
  1115.     DC.L    100
  1116.     DC.L    10
  1117.  
  1118. ;-----------------------------------------------------------------------
  1119. ;Output a text string pointed to by A6.
  1120. ; The string is terminated with a character having its MSB set.
  1121. ;
  1122. TEXTO    MOVEM.L    A0/A6,-(SP)    ;Save registers
  1123.     MOVEA.L    A6,A0        ;Get string address
  1124.  
  1125.     MOVEA.W    #12,A6        ;Set the function code to CHOUT
  1126.     BRA.S    TXT20        ;Enter loop
  1127.  
  1128. TXT10    JSR    VDEVHAN        ;Output D0
  1129. TXT20    MOVE.B    (A0)+,D0    ;Get char from string
  1130.     BPL.S    TXT10        ;Loop unitl the last character
  1131.  
  1132.     ANDI.B    #$7F,D0        ;Clear MSB
  1133.     JSR    VDEVHAN        ;Output D0
  1134.  
  1135.     MOVEM.L    (SP)+,A0/A6    ;Restore registers
  1136.     RTS
  1137.  
  1138. ;-----------------------------------------------------------------------
  1139. ;Input hex ASCII digits from DEVICE and convert them to a 32-bit value
  1140. ; which is returned in D0.
  1141. ;    D0 = Digit
  1142. ;    D1 = Accumulated value
  1143. ;    D2 = Digit counter
  1144. ;
  1145. HEXI    MOVEM.L    D1-D2,-(SP)    ;Save registers
  1146.     MOVEQ    #0,D1        ;Clear result register
  1147.     MOVEQ    #7,D2        ;Init digit counter (7 down through 0)
  1148.  
  1149. HEXI00    BSR    BYTEIN        ;Get byte
  1150.     CMPI.B    #'0',D0        ;Is character in range 0 thru 9?
  1151.     BLO.S    HEXI40        ;Branch if not
  1152.     CMPI.B    #'9',D0
  1153.     BHI.S    HEXI20        ;(May be A-F)
  1154.     SUBI.B    #'0',D0        ;Convert ASCII to binary value
  1155.     BRA.S    HEXI30        ;Go combine with other digits
  1156.  
  1157. HEXI20    ANDI.B    #$DF,D0        ;Force to uppercase
  1158.     CMPI.B    #'A',D0        ;Is character in range A thru F?
  1159.     BLO.S    HEXI40        ;Branch if not
  1160.     CMPI.B    #'F',D0
  1161.     BHI.S    HEXI40
  1162.     SUBI.B    #'A'-10,D0    ;Convert ASCII to binary value
  1163.  
  1164. HEXI30    ASL.L    #4,D1        ;Multiply current value by 16
  1165.     ADD.B    D0,D1        ;Add new digit
  1166.     DBF    D2,HEXI00    ;Exit if we have 8 digits
  1167.  
  1168. HEXI40    CMPI.B    #7,D2        ;Did we find a valid hex digit?
  1169.     BEQ.S    HEXI00        ;Branch if not -- keep trying
  1170.  
  1171.     MOVE.L    D1,D0        ;Return the hex value in D0
  1172.     MOVEM.L    (SP)+,D1-D2    ;Restore registers
  1173.     RTS
  1174.  
  1175. ;-----------------------------------------------------------------------
  1176. ;Output D0 in ASCII hex (8 digits)
  1177. ;
  1178. HEXO    SWAP    D0        ;Get high word
  1179.     BSR.S    WRDOUT        ;Output it
  1180.     SWAP    D0        ;(PFALL) get low word back
  1181.  
  1182. ;-----------------------------------------------------------------------
  1183. ;Output D0 in ASCII hex (4 digits)
  1184. ;
  1185. WRDOUT    ROR.W    #8,D0        ;Move high byte down (and save low byte)
  1186.     BSR.S    BYTOUT        ;Output it
  1187.     ROR.W    #8,D0        ;(PFALL) get low byte
  1188.  
  1189. ;-----------------------------------------------------------------------
  1190. ;Output D0 in ASCII hex (2 digits)
  1191. ;
  1192. BYTOUT    ROR.B    #4,D0        ;Move high nybble down (save low nybble)
  1193.     BSR.S    NYBOUT        ;Output it
  1194.     ROR.B    #4,D0        ;(PFALL) get low nybble
  1195.  
  1196. ;-----------------------------------------------------------------------
  1197. ;Output D0 in ASCII hex (1 digit)
  1198. ;
  1199. NYBOUT    MOVEM.L    D0/A6,-(SP)    ;Save registers
  1200.     ANDI.B    #$0F,D0        ;Work with low nybble only
  1201.     CMPI.B    #10,D0
  1202.     BLO.S    NO10
  1203.     ADDQ.B    #7,D0
  1204. NO10    ADDI.B    #'0',D0        ;Convert to ASCII
  1205.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  1206.     JSR    VDEVHAN        ;Output D0
  1207.     MOVEM.L    (SP)+,D0/A6    ;Restore registers
  1208.     RTS
  1209.  
  1210. ;-----------------------------------------------------------------------
  1211. ;Input a byte from DEVICE and return it in D0.
  1212. ;
  1213. BYTEIN    TST.B    BACKFL        ;Re-read the last character?
  1214.     BEQ.S    BYIN20        ;Branch if not
  1215.     CLR.B    BACKFL        ;Clear backup flag
  1216.     MOVEQ    #0,D0
  1217.     MOVE.B    LASTCH,D0    ;Return the last character
  1218.     RTS
  1219.  
  1220. BYIN20    MOVE.L    A6,-(SP)    ;Save A6
  1221.     MOVEA.W    #8,A6        ;Set the function code = CHIN
  1222.     JSR    VDEVHAN        ;Do I/O
  1223.     MOVE.B    D0,LASTCH    ;Save in case we need to re-read it
  1224.     MOVEA.L    (SP)+,A6    ;Restore A6
  1225.     RTS
  1226.  
  1227.     IF    @ > MEMTOP - $3000
  1228.     ERROR -- TOO BIG
  1229.     ENDIF
  1230.     END
  1231. in case we need to re-read it
  1232.     MOVEA